/* hs.rexx - single connection handler */
signal on syntax
signal on error
/**init **/
call getSocket
call init
/**get peer info**/
if ~getPeerInfo() then call errorAnswer(403,"Sorry,
you are not welcome here.")
/**read request **/
res=timedReadRequest()
if res~=0 then call errorAnswer(res)
/**check status**/
if ~getVirtualHost() then call errorAnswer(503)
/**check status**/
if global.status="PAUSED" then
call errorAnswer(503,"Sorry <"global.peer">,
This service is temporarily unavaible.")
/**check Ident service**/
if ~checkIdent() then
call errorAnswer(420,"Sorry <"global.peer">,
you must have the ident service running to access this site.")
/**log request**/
if global.TransferLog~="OFF" then
call transferLog("connection from" global.userat "Method:" global.method "Request:" global.file)
/**admin pure racism test**/
if global.OnlyAmigaClient="ON" & pos("AMIGA",upper(global.client))=0 then
call errorAnswer(403,"Sorry <"global.useratHTML">,
only Amiga clients are welcome here.")
/**check k-lines**/
res=checkIP()
if res~="" then
call errorAnswer(403,"Sorry <"global.useratHTML">,
you are not welcome here:" res)
/**now we can send the def.image**/
global.ErrorImage=global.DefImage=="ON"
/**parse file**/
res=parseFileName()
if res~=0 then do
select
when res=-1 then nop
when res=404 then call errorAnswer(404,"File" global.file "not found.
Mail the system admin if you think that's not correct.")
otherwise call errorAnswer(res)
end
end
/**check Auth**/
res=checkAuth()
if res~="" then do
call sen createHead(401,"text/html",,res) || "hserv Auth Error![def.gif](http://"hostName()"/def.gif)
Sorry <"global.useratHTML">,
you don't have access to" '"'res'".
'
exit
end
/**methods**/
select
when global.method="GET" then do
if global.since~="" then
if ~checkSince(global.since,global.complete) then call errorAnswer(304)
if global.handler="SEND" then call timedSendFile(global.complete,0,0,200)
else call doCGI
end
when global.method="POST" then call doCGI
when global.method="HEAD" then call timedSendFile(global.complete,1,0,200)
otherwise call errorAnswer(400)
end
exit
/***************************************************************************/
getSocket: procedure expose global.
global.sock=LastSocket()
if global.sock=-1 then do
call EasyRequest("hs can only be started by hserv .")
exit
end
return
/***************************************************************************/
init: procedure expose global.
call ReadConfig
call pragma("D",global.RootDir)
call pragma("P",global.Pri)
global.ErrorImage=0
global.defMime="text/plain"
global.inetDate="%m %w %d %Y %H:%M:%S GMT"
global.err5=0
global.timer=CreateTimer()
global.timers=TimerSignal(global.timer)
call SetSocketSignals(global.timers)
return
/***************************************************************************/
doCGI: procedure expose global.
f=exCGI(global.complete,global.args,global.handler)
if f~="" then call timedSendFile(f,0,1,200)
return
/***************************************************************************/
sen: procedure expose global.
parse arg string
res=send(global.sock,string)
if res~=length(string) then call ErrLog("error seanding %m" global.peer)
return
/***************************************************************************/
timedReadRequest: procedure expose global.
call StartTimer(global.timer,global.timeout)
res=readRequest()
call StopTimer(global.timer)
return res
/***************************************************************************/
readRequest: procedure expose global.
head=""
do try=0 to 1 while head=""
if recvline(global.sock,"HEAD",256)<0 then do
if errno()=4 then return 410
else call ErrLog("error reading %m" global.peer)
return 500
end
end
if try=2 then do
call ErrLog("empty request" global.peer)
exit
end
if words(head)~=3 then return 400
parse var head global.method" "global.file" HTTP/"maior"."minor
if maior<1 then return 505
global.since=""
global.authorization=""
global.ContentLength=""
global.client=""
global.range=""
global.RKeepAlive=""
global.Host=""
stop=0
do k=0 to 20 while ~stop
if recvline(global.sock,"LINE",256)<0 then do
if errno()=4 then return 410
else do
call ErrLog("error reading %m" global.peer)
return 500
end
end
else
if line~="D0A"x then do
parse var line f": "rest "D"x
f=upper(f)
select
when f="IF-MODIFIED-SINCE" then global.since=rest
when f="AUTHORIZATION" then parse var rest "Basic "global.authorization .
when f="CONTENT-LENGTH" then global.ContentLength=rest
when f="USER-AGENT" then global.client=rest
when f="RANGE" then global.range=rest
when f="KEEPALIVE" then global.RKeepAlive=rest
when f="HOST" then global.Host=rest
otherwise nop
end
global.request.k=line
call SetVar(f,rest,"LOCAL")
end
else stop=1
end
if global.host="" then global.host=hostName()":"global.port
parse var global.host global.host":" global.hostport .
if global.hostport="" then global.hostport=global.port
else if global.hostport~=global.port then return 400
global.request.num=k-1
if global.method="POST" then do
if global.ContentLength~="" then pl=global.ContentLength
else return 411
if pl>1024 then return 406
len=recv(global.sock,"BUF",pl)
if len<0 then do
if errno()=4 then return 410
call ErrLog("error reading %m" global.peer)
return 500
end
if pl~=len then return 410
parse var buf global.args"D"x
end
return 0
/***************************************************************************/
readConfig: procedure expose global.
global.RootDir=PathPart(ProgramName("FULL"))
global.HostName=GetVar("hserv_HostName","LOCAL")
global.admin=GetVar("hserv_Admin","LOCAL")
global.ver=GetVar("hserv_Ver","LOCAL")
global.port=GetVar("hserv_Port","LOCAL")
global.VirtualHosts=GetVar("hserv_VirtualHosts","LOCAL")
global.DocumentDir=GetVar("hserv_DocumentDir","LOCAL")
global.DocumentIndex=GetVar("hserv_DocumentIndex","LOCAL")
global.CGIDir=GetVar("hserv_CgiDir","LOCAL")
global.ErrorLog=GetVar("hserv_ErrorLog","LOCAL")
global.ErrorFile=GetVar("hserv_ErrorFile","LOCAL")
global.TransferLog=GetVar("hserv_TransferLog","LOCAL")
global.TransferFile=GetVar("hserv_TransferFile","LOCAL")
global.auth=GetVar("hserv_Auth","LOCAL")
global.KeepAlive=GetVar("hserv_KeepAlive","LOCAL")
global.KeepAliveTimeout=GetVar("hserv_KeepAliveTimeout","LOCAL")
global.Timeout=GetVar("hserv_Timeout","LOCAL")
global.RejectedIP=GetVar("hserv_RejectedIP","LOCAL")
if global.RejectedIP="" then
global.HostNameLookups=GetVar("hserv_HostNameLookups","LOCAL")
else global.HostNameLookups="ON"
global.MimeFile=GetVar("hserv_MimeFile","LOCAL")
global.OnlyAmigaClient=GetVar("hserv_OnlyAmigaClient","LOCAL")
global.DefImage=GetVar("hserv_DefImage","LOCAL")
global.ident=GetVar("hserv_Ident","LOCAL")
global.pri=GetVar("hserv_Pri","LOCAL")
global.status=GetVar("hserv_Status","LOCAL")
global.Specials=GetVar("hserv_Specials","LOCAL")
global.Handlers=GetVar("hserv_Handlers","LOCAL")
global.Errors=GetVar("hserv_Errors","LOCAL")
return
/***************************************************************************/
getPeerInfo: procedure expose global.
if GetPeerName(global.sock,"GLOBAL")<0 then do
call ErrLog("can't get peer info %m")
return 0
end
global.peer=global.addrAddr
global.peerPort=global.addrPort
if global.HostNameLookups="ON" then
if GetHostByAddr("HOST",global.addrAddr) then global.peer=host.hostName
else return 0
return 1
/***************************************************************************/
authFun: procedure
parse arg ha, lp, sp
sock=socket("INET","STREAM")
if sock<0 then return "-ERR" errno()
sin.addrAddr=ha
sin.addrPort=113
if connect(sock,"SIN")<0 then do
call CloseSocket(sock)
return "-ERR" errno()
end
request=sp","lp"D0A"x
if send(sock,request)<0 then do
call CloseSocket(sock)
return "-ERR" errno()
end
ans=""
len=recv(sock,"BUF",256)
do while len>0
ans=ans || buf
len=recv(sock,"BUF",256)
end
call CloseSocket(sock)
if len<0 then return "-ERR" errno()
if index(ans,"ERROR")~=0 then do
parse var ans "ERROR:" rest
return "+OK unknown"
end
parse var ans ans"D0A"x
return "+OK "ans
/***************************************************************************/
checkIdent: procedure expose global.
if global.ident="ON" then do
auth=AuthFun(global.addrAddr,global.port,global.addrPort)
if left(auth,4)="-ERR" then do
call ErrLog("can't get ident info for" global.peer)
return 0
end
else parse var auth"+OK" rp "," lp ": USERID : " sis " : " global.user
global.useratHTML=global.user"@"global.peer
global.userat="<"global.useratHTML":"global.peerPort">"
end
else do
global.user=""
global.useratHTML=global.peer
global.userat="<"global.useratHTML":"global.peerPort">"
end
return 1
/***************************************************************************/
errorAnswer: procedure expose global.
parse arg code,h
if global.errors~="" then do
lines=ParseConfig(global.errors,"ERRORS","NOUPPER")
if lines==-1 then do
call ErrLog("Errors file '"global.Errors"' not found")
exit
end
do i=0 to lines-1
if errors.i~=code then iterate
parse var errors.i.value macro newcode .
if newcode="" then newcode=code
f=exCGI(macro,newcode global.file,getHandler(macro))
call timedSendFile(f,0,1,newcode)
exit
end
end
else do
msg=createHead(code,"text/html")
if h~="" then do
msg=msg"hserv error"
if global.ErrorImage=1 then
msg=msg""
else
msg=msg"hserv "global.ver"
"
msg=msg"
" h "
"
end
call sen msg
end
exit
/***************************************************************************/
timedSendFile: procedure expose global.
parse arg complete,head,cgi,code
call StartTimer(global.timer,global.Timeout)
call sendFile(complete,head,cgi,code)
call StopTimer(global.timer)
return
/***************************************************************************/
sendFile: procedure expose global.
parse arg complete,head,cgi,code
resume=0
f=0
if ~cgi then t=global.size-1
delta=1024
if ~open("IN",complete,"R") then do
call ErrLog("unable to open" complete global.peer)
call errorAnswer(404)
end
if cgi then do
mime=ReadLN("IN")
call ReadLN("IN")
length=""
last=""
end
else do
mime=getMime(complete)
last=GMTInetFileDate(complete)
length=global.size
end
if cgi | pos("text",mime)~=0 then length=""
else
if global.range~="" then do
parse var global.range "bytes="ff"-"tt","d1 d2
if ff="" then ff=f
if tt="" then tt=t
if d1="" & d2="" & tt=0 & ff<=tt then do
resume=1
code=206
f=ff
t=tt
length=t-f+1
if length=1 then delta=1
else
do while delta>length
delta=delta%2
end
end
end
ss=createHead(code,mime,length,"",last,cgi)
if head then do
call close("IN")
call sen ss
return
end
if ~cgi then call Seek("IN",f,"BEGIN")
a=readch("IN",delta)
if a="" then do
call ErrLog("error file" complete "is empty" global.peer)
call errorAnswer(500)
end
sent=length(a)
if length="" then a=parseText(a)
a=ss||a
res=send(global.sock,a)
if res~=length(a) then do
if errno()~=4 then
call ErrLog("error seanding %m" global.peer)
return
end
do while ~eof("IN")
if resume then if sent>=length then leave
a=readch("IN",delta)
if a~="" then do
l=length(a)
if resume then do
if l+sent>length then do
l=length-l
a=left(a,l)
end
end
sent=sent+l
if length="" then a=parseText(a)
if res" b
a=a || include(file) || b
end
when index(a,"" b
a=a || include(file) || b
end
when index(a,"")~=0 then do
parse var a a "" b
a=a || global.peer || b
end
when index(a,"")~=0 then do
parse var a a "" b
a=a || global.useratHTML || b
end
when index(a,"")~=0 then do
parse var a a "" b
a=a || global.user || b
end
when index(a,"")~=0 then do
parse var a a "" b
a=a || "Powered Up with rxsocket.library!" || b
end
when index(a,"")~=0 then do
parse var a a "" b
a=a || global.complete || b
end
when index(a,"")~=0 then do
parse var a a "" b
a=a || GMTInetCurrentDate() || b
end
when index(a,"")~=0 then do
parse var a a "" b
a=a || "hserv" global.ver || b
end
when index(a,"")~=0 then do
parse var a a "" b
a=a || ''global.admin'' || b
end
when index(a,"" b
p=PathPart(fun)
if p~="" then old=pragma("D",p)
else old=pragma("D",global.CGIDir)
INTERPRET "res="fun
old=pragma("D",old)
a=a || res || b
end
otherwise do
stop=1
end
end
end
stop=0
do while ~stop
select
when index(a,"" b
macro=AddPart(global.CGIDir,fun)
f=exCGI(macro,arg,getHandler(macro))
if f~="" then
if open("CGI",f,"READ") then do
l=ReadLn("CGI")
call ReadLn("CGI")
do while ~eof("CGI")
l=ReadLn("CGI")
if l~="" then a=a||l
end
call Close("CGI")
end
a=a||b
end
otherwise stop=1
end
end
return a
/***************************************************************************/
exCGI: procedure expose global.
parse arg macro,args,handler
f=CreateTempFile()
if f="" then do
call ErrLog("error macro" macro "returned" rc global.peer)
return ""
end
o=pragma("D",PathPart(macro))
macro=FilePart(macro)
select
when handler="CGI" then cmd="perl "f '"'addpart(pragma(D),macro)'"' args
when handler="REXX" then cmd="rx "f macro args
when handler="REBOL" then cmd="work:rebol/rebol -cqw "f macro args
when handler="EXE" then cmd=macro ""f args
otherwise cmd=""
end
if cmd~="" then do
global.err5=1
SHELL COMMAND cmd
global.err5=0
call pragma("D",o)
if rc~=0 then do
call ErrLog("error macro" macro "returned" rc global.peer)
f=""
end
end
else f=""
call pragma("D",o)
return f
/***************************************************************************/
getHeadString: procedure
parse arg code
select
when code=100 then s="Continue"
when code=101 then s="Switching Protocols"
when code=200 then s="OK"
when code=201 then s="Created"
when code=202 then s="Accepted"
when code=203 then s="Non-Authoritative Information"
when code=204 then s="No Content"
when code=205 then s="Reset Content"
when code=206 then s="Partial Content"
when code=300 then s="Multiple Choices"
when code=301 then s="Moved Permanently"
when code=302 then s="Moved Temporarily"
when code=303 then s="See Other"
when code=304 then s="Not Modified"
when code=305 then s="Use Proxy"
when code=400 then s="Bad Request"
when code=401 then s="Unauthorized"
when code=402 then s="Payment Required"
when code=403 then s="Forbidden"
when code=404 then s="Not Found"
when code=405 then s="Method Not Allowed"
when code=406 then s="Not Acceptable"
when code=407 then s="Proxy Authentication Required"
when code=408 then s="Request Time-out"
when code=409 then s="Conflict"
when code=410 then s="Gone"
when code=411 then s="Length Required"
when code=412 then s="Precondition Failed"
when code=413 then s="Request Entity Too Large"
when code=414 then s="Request-URI Too Large"
when code=415 then s="Unsupported Media Type"
when code=420 then s="No ident service running"
when code=500 then s="Internal Server Error"
when code=501 then s="Not Implemented"
when code=502 then s="Bad Gateway"
when code=503 then s="Service Unavailable"
when code=504 then s="Gateway Time-out"
when code=505 then s="HTTP Version not supported"
otherwise s="Code:" code
end
return "HTTP/1.0" code s
/***************************************************************************/
createHead: procedure expose global.
parse arg code,mime,length,realm,last,cgi
msg=getHeadString(code) || "D0A"x || "Server: hserv/" || global.ver || "D0A"x || "Date:" GMTInetCurrentDate() || "D0A"x
if realm~="" then msg=msg || "WWW-Authenticate: Basic realm=" || '"' || realm || '"' || "D0A"x
if length~="" then msg=msg || "Content-Length:" length || "D0A"x
if last~="" then msg=msg || "Last-Modified:" last || "D0A"x
if cgi=1 then msg=msg || mime || "D0A"x
else msg=msg || "Content-Type:" mime || "D0A"x
msg=msg || "Connection: closed" || "D0A"x
msg=msg || "D0A"x
return msg
/***************************************************************************/
parseFileName: procedure expose global.
if global.file="" then return 400
res = parseURL("GLOBAL.TEMP",global.file)
if res>0 then return res
if global.temp.host~="" then do
if global.host~=global.temp.host | global.hostport~=global.temp.port then return 400
global.host=global.temp.host
global.file=global.temp.file
end
if (index(global.file,"//")~=0) | (index(global.file,":")~=0) then
return 404
pf=PathPart(global.file)
if pf="" then return 400
if FilePart(global.file)="" then
global.file=AddPart(global.file,global.DocumentIndex)
if (global.args="") & (global.post="") then
global.complete=AddPart(global.DocumentDir,right(global.file,length(global.file)-1))
else do
if (global.method~="POST") then
parse var global.file global.file"?"global.args
end
if upper(left(pf,8))="/CGI-BIN" then
global.complete=AddPart(global.CGIDir,FilePart(global.file))
else
global.complete=AddPart(global.DocumentDir,right(global.file,length(global.file)-1))
if checkSpecials() then return -1
s=statef(global.complete)
if word(s,1)~="FILE" then return 404
global.size=word(s,2)
global.handler=getHandler(global.complete)
return 0
/***************************************************************************/
getHandler: procedure expose global.
parse arg file
l=lastpos(".",file)
le=length(file)
if l~=0 & l~=le then ext=upper(right(file,le-l))
else ext=""
select
when ext="CGI" then res="CGI"
when ext="REXX" then res="REXX"
when ext="R" then res="REBOL"
when ext="" then res="EXE"
otherwise res="SEND"
end
if global.handlers~="" then do
lines=ParseConfig(global.Handlers,"HANDLERS","SIMPLECOMMENT")
if lines==-1 then do
call ErrLog("Handlers file '"global.Handlers"' not found")
return res
end
do i=0 to lines-1
if RMH_match(handlers.i,file) then return handlers.i.value
end
end
return res
/***************************************************************************/
syntax:
call EasyRequest(ErrorText(rc)d2c(10)"Line:" sigl,"hs Syntax error")
exit
/***************************************************************************/
error:
if global.err5 then err="command returned" 5
else err=ErrorText(rc)
call EasyRequest(err||d2c(10)"Line:" sigl,"hs Error")
exit
/***************************************************************************/
hostName: procedure expose global.
hname=global.HostName
if hname="" then do
call GetSockName(global.sock,"N")
hname=n.AddrAddr
end
return hname
/***************************************************************************/
errLog: procedure expose global.
parse arg msg
select
when global.ErrorLog="OFF" then return 1
when global.ErrorLogl="ON" then do
if ~open("LOG",global.ErrorFile,"A") then
if ~open("LOG",ef,"W") then return 0
call WriteLN("LOG","hs ("global.port")" date() time() msg)
end
when global.ErrorLog="SYS" then call SysLog(msg,"INFO")
otherwise nop
end
return 1
/***************************************************************************/
transferLog: procedure expose global.
parse arg msg
select
when global.TransferLog="OFF" then return 1
when global.TransferLog="ON" then do
if ~open("LOG",tf,"A") then
if ~open("LOG",global.TransferFile,"W") then return 0
call WriteLN("LOG","hs ("global.port")" date() time() msg)
end
when global.TransferLog="SYS" then do
msg=decode(msg)
call SysLog(msg,"INFO")
end
otherwise nop
end
return 1
/***************************************************************************/
checkIP: procedure expose global.
if global.RejectedIP="" then return ""
lines=ParseConfig(global.RejectedIP,"IPS")
if lines=-1 then do
call ErrLog("RejectedIP file '"global.RejectedIP"' not found")
return ""
end
do i=0 to lines-1
patt=RMH_match(ips.i,global.peer) then return ips.i.value
end
return ""
/***************************************************************************/
checkAuth: procedure expose global.
if global.Auth="" then return ""
lines=ParseConfig(global.Auth,"AL","SIMPLECOMMENT")
if lines=-1 then do
call ErrLog("Auth file '"global.Auth"' not found")
return "Secret World"
end
do i=0 to lines-1
if ~RMH_match(al.i,global.complete) then iterate
parse var al.i.value realm login pass .
if global.Authorization="" then return realm
enc=encodeB64(login":"pass)
if enc=global.Authorization then return ""
return realm
end
return ""
/***************************************************************************/
encodeB64: procedure
parse arg s
if length(s)>20 then return ""
s=c2b(s)
a=""
do while s~=""
parse var s c +6 s
a=a||substr("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",c2d(b2c(left(c"0000",6)))+1,1)
end
l=length(c)
if l<6 then a=a||copies("=",(6-l)/2)
return a
/***************************************************************************/
decode: procedure
parse arg msg
res=""
do while pos("%",msg)~=0
parse var msg a "%" msg
res = res || a || "%%"
end
return res || msg
/***************************************************************************/
getMime: procedure expose global.
parse arg file
l=lastpos(".",file)
ll=length(file)
if l~=0 & l~=ll then ext=upper(right(file,ll-l))
else ext=""
if ext=="" | MimeFile=="" then return global.defMime
lines=ParseConfig(global.MimeFile,"MIMES","NOUPPER")
if lines==-1 then do
call ErrLog("Mime file '"global.mimeFile"' not found")
return global.defMime
end
do i=0 to lines-1
if find(upper(mimes.i.value),upper(ext))~=0 then return mimes.i
end
return global.defMime
/***************************************************************************/
debug: procedure expose global.
parse arg msg
do i=0 to global.request.num-1
call SysLog(decode(global.request.i))
end
call SysLog(msg)
return
/***************************************************************************/
GMTInetCurrentDate: procedure expose global.
call GetDate("D","GMT")
return translateDate(formatdate("D",global.inetDate))
/***************************************************************************/
GMTInetFileDate: procedure expose global.
parse arg file
call GetDate("NOW","GMT")
date="NOW"
if GetFileDate(file,"FD") then do
call date2gmt("FD")
if CompareDates("NOW","FD")<0 then date="FD"
end
return translateDate(formatdate(date,global.inetDate))
/***************************************************************************/
translateDate: procedure
d.0="Sun";d.1="Mon";d.2="Tue";d.3="Wed";d.4="Thu";d.5="Fri";d.6="Sat"
m.1="Jan";m.2="Feb";m.3="Mar";m.4="Apr";m.5="May";m.6="Jun";m.7="Jul";m.8="Aug";m.9="Sep";m.10="Oct";m.11="Nov";m.12="Dec"
parse arg i j rest
i=i%1
return d.j"," m.i || rest
/***************************************************************************/
checkSince: procedure
parse arg since,file
marray="JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBEROCTOBER NOVEMBER DECEMBER"
darray="SUNDAY MONDAY TUESDAY WEDNESDAYTHURSDAY FRIDAY SATURDAY"
fmt="%d %m %Y %H:%M:%S"
since=upper(since)
date.0='dayname"," month day year hour":"minute":"second'
date.1='dayname"," day month year hour":"minute":"second'
date.2='dayname"," day "-" month "-" year hour":"minute":"second'
date.3='dayname month day hour":"minute":"second year'
found=0
do i=0 to 3 while ~found
line="parse var since" date.i "."
INTERPRET line
if length(dayname)<2 then iterate
if pos(dayname,darray)=0 then iterate
if length(month)<2 then iterate
p=pos(month,marray)
if p=0 then iterate
month=right(p%9+1,2)
if year<1900 then year=year+1900
if month~=0 then do
date = day month year hour":"minute":"second
found=ParseDate(date,fmt,"SD")
end
end
if ~found then return 1
call GetDate("NOW","GMT")
call GetFileDate(file,"FD")
call date2gmt("FD")
if CompareDates("NOW","FD")>0 then return 1
if CompareDates("NOW","SD")>0 then return 1
fd.tick=fd.tick-fd.tick//100
sd.tick=sd.tick-sd.tick//100
return CompareDates("FD","SD")<0
/***************************************************************************/
checkSpecials: procedure expose global.
if global.Specials="" then return 0
lines=ParseConfig(global.Specials,"SP","SIMPLECOMMENT")
if lines=-1 then do
call ErrLog("Special file '"global.Specials"' not found")
return 0
end
do i=0 to lines-1
if RMH_match(sp.i,global.complete) then leave
end
if i=lines then return 0
parse var sp.i.value type " " a " " b
select
when type="CODE" then do
msg=getHeadString(a) || "D0A"x || "Server: hserv/" || global.ver || "D0A"x || "Date:" GMTInetCurrentDate() || "D0A"x
msg=msg || b || "D0A"x || "D0A"x
call sen msg
end
when type="CALL" then call RXSCall(a b,global.sock,"SYNC")
otherwise return 0
end
return 1
/***************************************************************************/
getVirtualHost: procedure expose global.
if global.VirtualHosts="" then return 1
lines=ParseConfig(global.VirtualHosts,"VH","SIMPLECOMMENT")
if lines=-1 then do
call ErrLog("Auth file '"global.VirtualHosts"' not found")
return 0
end
do i=0 to lines-1
if RMH_match(vh.i,global.host) then do
parse var vh.i.value d i .
if d="" then return 0
global.DocumentDir=d
call SetVar("hserv_DocumentDir",d,"LOCAL")
if i="" then i=global.DocumentIndex
else do
global.DocumentIndex=i
call SetVar("hserv_DocumentIndex",i,"LOCAL")
end
return 1
end
end
return 1
/***************************************************************************/
include: procedure expose global.
parse arg file
if file="" then return "no file given"
parse var file '"' f '"'
if f~="" then file=f
p=PathPart(file)
if p="" then o=pragma("D",global.DocumentDir)
else o=pragma("D",p)
if open("INCLUDE",file,"R") then do
res=""
do while ~eof("INCLUDE")
res=res || readln("INCLUDE")
end
call close("INCLUDE")
end
else res="can't find file '"file"'"
call pragma("D",o)
return res
/***************************************************************************/
parseUrl: procedure expose global.
parse arg stem,u
if u="" then return 400
p=80
f=""
l=""
pw=""
pr = match("#?://#?",u)
if pr then do
parse var u proto "://" u
if upper(left(proto,7))~="HTTP" then return 400
end
if match("#?:#?@#?",u) then do
parse var u l":"pw"@"u
if l="" | pw="" | u="" then return 400
end
if match("#?/#?",u) then do
parse var u u "/" f
end
f = "/"f
if match("#?:#?",u) then do
parse var u u ":" p
if ~DataType(p,"N") then return 400
if p<1 | p>65535 then return 400
pr=1
end
if pr then if u="" then return 400
interpret stem".HOST='"u"'"
interpret stem".PORT='"p"'"
interpret stem".FILE='"f"'"
return 0
/***************************************************************************/
/* $VER: hs.rexx 13.1 (17.5.99) */